% Objective Turing dialect from ICCL TXL Objective Turing paper
% J.R. Cordy, October 1988
% Using new 6.2 predefined externals

include "Turing.Grammar"


% Syntactic forms to add object types

define typeSpec 
	[objectType]       	% added new syntactic form     
    |	[standardType]     	% original Turing 
    |	[arrayType]        	%        type spec syntactic forms 
    |	[recordType]
    |	[enumeratedType]
    |	[setType]
    |	[unionType]
    |	[collectionType]
    |	[pointerType]
    |	[subrangeType]
    |	[namedType]
end define 

keys
	'object
end keys

define objectType 
						[IN][NL]
	'object 				[NL][IN]
            [importList]   	% contents same as original Turing module form
            [exportList]     
            [repeat declarationOrStatement] 	[EX]
        'end [id] 				[EX][NL]
end define 


% Type class polymorphism syntactic forms

define declaration
	[typeClassDeclaration]	% new added syntactic form
    |	[moduleDeclaration]	% original Turing declaration
    |	[constantDeclaration]	%	syntactic forms
    |	[typeDeclaration]
    |	[variableDeclaration]
    |	[variableBinding]
    |	[subprogramDeclaration]
end define

define typeSpec
	[instanceType]		% new added
    |	[objectType]       	%	syntactic forms
    |	[standardType]		% original Turing syntactic			
    |	[arrayType]		% 	forms
    |	[recordType]
    |	[enumeratedType]
    |	[setType]
    |	[unionType]
    |	[collectionType]
    |	[pointerType]
    |	[subrangeType]
    |	[namedType]
end define

define typeClassDeclaration 
        'type class [id]  ( [list id] ) : [typeSpec] 
end define 

keys
    	'instance
end keys

define instanceType 
	instance [id]  ( [list expnOrTypeSpec] ) 
end define 

define expnOrTypeSpec
	[id]			% This is the ambiguous case - could be either.
    |	[typeSpec]	% All types
    |	[expn]		% All expressions
end define


% Inheritance syntactic forms

define objectType 
						[IN][NL]
	'object					[NL][IN]
            [optRefinementClause] 	% added to objectType form
            [importList] 
            [exportList]     
            [repeat declarationOrStatement] 	[EX]
        'end [id] 				[EX][NL]
end define 

define optRefinementClause
	[refinementClause]
    |	[empty]
end define

keys
	'refines
end keys

define refinementClause
	'refines [id]	[NL]
end define


% Modified syntax of declarations to allow easy sorting

define declaration
	[constantTypeOrModuleDeclaration]
    |	[variableOrSubprogramDeclaration]
end define

define variableOrSubprogramDeclaration
	[variableDeclaration]
    |	[variableBinding]
    |	[subprogramDeclaration]
end define

define constantTypeOrModuleDeclaration
	[constantDeclaration]
    |	[typeClassDeclaration]	
    |	[typeDeclaration]
    |	[moduleDeclaration]
end define


% Modified syntax of import and export lists to allow splicing

define importList 
	'import ( [importItems] )	[NL]
end define

define importItems
	 [list optVarOrForwardId] 
end define

define exportList 
	'export ( [exportItems] )	[NL]
end define

define exportItems
	[list optOpaqueId] 
end define



% Rules for transformation of object types
 
function main
    replace [program]
        P [repeat declarationOrStatement]
    by
        P [fixTypeClasses]
          [fixInheritedObjectTypes]
          [fixObjects] 
end function


% Step 1.  Convert Object Types to Modules. 

rule fixObjects 
    replace [repeat declarationOrStatement] 
        type ObName [id] : 
            object 
                ObImport [importList] 
                ObExport [exportList] 
                ObBody [repeat declarationOrStatement] 
            'end ObName 
        RestOfScope [repeat declarationOrStatement] 
    by
        module ObName 
            ObImport 
            ObExport  [addObjectAndInitializerExport] 
            ObBody 
                [sortDeclarationsAndStatements] 
                [makeObjectRecordTypeAndEnterFields] 
                [makeObjectInitializerProcedureAndEnterStatements] 
                [addObjectParameterToProcedures] 
        'end ObName 
        RestOfScope     
                [transformObjectReferences ObName]
	        [transformCollectionObjects ObName]
end rule 


%Step 2. Add Exported Names for the Object Data Record Type and the      
%        Object Initializer Procedure.  

function addObjectAndInitializerExport 
    replace [exportList] 
       'export ( OldExports [list optOpaqueId] ) 
    construct NewExports [list optOpaqueId]
	'DataRecordType, 'InitializeDataRecord
    by
        'export ( NewExports [, OldExports] )
end function


%Step 3. Sort the Declarations and Statements in the Object Module. 

rule sortDeclarationsAndStatements 
    replace [repeat declarationOrStatement] 
        ObBody [repeat declarationOrStatement] 
    construct NewBody [repeat declarationOrStatement]
        ObBody 
            [sortDS]    % declarations before statements 
            [sortTV]    % constants, types and modules before 
                        %        variables and procedures 
            [sortVP]    % then variables, then procs 
    where not
	NewBody [= ObBody]
    by
	NewBody
end rule 

rule sortDS 
    replace [repeat declarationOrStatement] 
        S [statement] 
        D [declaration] 
        R [repeat declarationOrStatement] 
    by
        D 
        S 
        R 
end rule 

rule sortTV 
    replace [repeat declarationOrStatement] 
        V [variableOrSubprogramDeclaration] 
        T [constantTypeOrModuleDeclaration] 
        R [repeat declarationOrStatement] 
    by
        T 
        V 
        R 
end rule 

rule sortVP 
    replace [repeat declarationOrStatement] 
        P [subprogramDeclaration] 
        V [variableDeclaration] 
        R [repeat declarationOrStatement] 
    by
        V 
        P 
        R 
end rule 


% Step 4.  Gather the Object Module's Private Variables into the Object Data Record Type.  

function makeObjectRecordTypeAndEnterFields 
    replace [repeat declarationOrStatement] 
        ObBody [repeat declarationOrStatement] 
    by
        ObBody
            [makeObjectRecordType]  
            [enterObjectRecordTypeFields] 
end function 

rule makeObjectRecordType 
    replace [repeat declarationOrStatement] 
        V [variableDeclaration] 
	P [subprogramDeclaration]
        Rest  [repeat declarationOrStatement] 
    by
        V 
        type 'DataRecordType : 
            record 
            'end record 
	P
        Rest 
end rule 

rule enterObjectRecordTypeFields 
    replace [repeat declarationOrStatement] 
        var V [id] : T [typeSpec] 
        type 'DataRecordType : 
            record 
                R [repeat recordField] 
            'end record 
        RestOfScope [repeat declarationOrStatement] 
    by
        type 'DataRecordType : 
            record 
                V : T 
                R 
            'end record 
        RestOfScope  [fixObjectVariableReferences V] 
end rule 


% Step 5.   Change References to the Object's Private Variables to 
%     Reference the Data Record Parameter of the Object Procedures.  

rule fixObjectVariableReferences Var [id] 
    replace [reference]
	Var Rest [repeat componentSelector]
    by
	DataRecord . Var Rest
end rule

% Step 6.  Gather the Object Module's Initializing Statements into the 
%     Object Data Record Initializer Procedure.  

rule makeObjectInitializerProcedureAndEnterStatements 
    replace [repeat declarationOrStatement] 
        P [subprogramDeclaration] 
        S [statement] 
        Rest [repeat declarationOrStatement] 
    by
        P 
        procedure InitializeDataRecord (var DataRecord : DataRecordType) 
            S 
            Rest 
        'end InitializeDataRecord 
end rule 


% Step 7.  Add an Object Data Record Parameter to Each Procedure of the Module.  

rule addObjectParameterToProcedures 
    replace [repeat declarationOrStatement] 
        procedure PName [id]  ( Arg1 [parameterDeclaration]  
                  RestOfArgs [repeat commaParameterDecl] ) 
            PBody [subprogramBody] 
        procedure InitializeDataRecord  
                InitPList [opt parameterList] 
            IBody [subprogramBody] 
        RestOfScope [repeat declarationOrStatement] 
    by
        procedure InitializeDataRecord  InitPList 
            IBody 
        procedure PName ( var DataRecord : DataRecordType,  
                    Arg1  RestOfArgs ) 
            PBody 
        RestOfScope 
end rule 


% Step 8. Transform Declarations of Instances of the Object Type into Declarations of 
%	Object DataRecords.  

rule transformObjectReferences  ObName [id] 
    replace [repeat declarationOrStatement] 
        var ObVar [id] : ObName 
        RestOfScope [repeat declarationOrStatement] 
    by
        var ObVar : ObName . DataRecordType 
        ObName . InitializeDataRecord (ObVar) 
        RestOfScope [changeObjectProcedureCalls ObVar ObName] 
end rule 


% Step 9.  Change Calls to the Object Instance's Procedures into Calls to the Object Module.  

rule changeObjectProcedureCalls  ObVar [id]  ObName [id] 
    replace [procedureCall] 
        ObVar . PName [id]  ( FirstArg [expn]  RestOfArgs [repeat commaExpn] ) 
    by
        ObName . PName (ObVar, FirstArg RestOfArgs) 
end rule 


% Rules for transforming type classes

rule fixTypeClasses 
    replace [repeat declarationOrStatement] 
        type class TCname [id] ( Formals [list id] ) : 
                TCbody  [typeSpec] 
        RestOfScope [repeat declarationOrStatement] 
    by
        RestOfScope [fixInstantiations TCname Formals TCbody] 
end rule 

rule fixInstantiations TCname [id] Formals [list id] TCbody [typeSpec] 
    replace [declaration] 
        type ITname [id] : 
            instance TCname ( Actuals [list expnOrTypeSpec] ) 
    by
        type ITname : 
            TCbody  [substituteId TCname ITname]
	    		[substituteAmbiguousArgs each Formals Actuals]
	    		[substituteExpnArgs each Formals Actuals]
	    		[substituteTypeArgs each Formals Actuals]
end rule 

rule substituteId Old [id] New [id] 
    replace [id] 
        Old 
    by
        New 
end rule 

rule substituteAmbiguousArgs Old [id] New [expnOrTypeSpec]
    deconstruct New
	NewName [id]
    replace [id]
	Old
    by
	NewName
end rule

rule substituteExpnArgs Old [id] New [expnOrTypeSpec]
    deconstruct New
	NewExpn [expn]
    replace [primary]
	Old
    by
	( NewExpn )
end rule

rule substituteTypeArgs Old [id] New [expnOrTypeSpec]
    deconstruct New
	NewTypeSpec [typeSpec]
    replace [typeSpec]
	Old
    by
	NewTypeSpec
end rule


% Rules for handling inheritance

rule fixInheritedObjectTypes
    replace [repeat declarationOrStatement]
        type Oname [id]  :
            object
                Oimp [importList]
                Oexp [exportList]
                Obody [repeat declarationOrStatement]
            'end Oname
        RestOfScope [repeat declarationOrStatement]
    where
	RestOfScope [hasRefines Oname]
    by
        type Oname  :
            object
                Oimp
                Oexp 
                Obody
            'end Oname
        RestOfScope  [fixInheritedObjectTypeRefinements Oname Oimp Oexp Obody]
end rule

function hasRefines OName [id]
    match * [refinementClause]
	'refines OName
end function

rule fixInheritedObjectTypeRefinements  Oname [id] Oimp [importList] Oexp [exportList] 
        Obody [repeat declarationOrStatement]
    replace [repeat declarationOrStatement]
        type ORname [id] :
            object 
		refines Oname 
                'import ( ORimports [list optVarOrForwardId] )
                'export ( ORexports [list optOpaqueId] ) 
                ORbody [repeat declarationOrStatement]
            'end ORname
        RestOfScope [repeat declarationOrStatement]
    by
        type ORname :
            object  
                Oimp [addNewImports ORimports]
                Oexp [addNewExports ORexports]
                Obody [. ORbody]
            'end ORname
        RestOfScope
end rule

function spliceBody ORbody [repeat declarationOrStatement]
    replace [repeat declarationOrStatement]
	OBfirst [declarationOrStatement] OBrest [repeat declarationOrStatement]
    by
	OBfirst OBrest [spliceBody ORbody] [catenateBody ORbody]
end function

function catenateBody ORbody [repeat declarationOrStatement]
    replace [repeat declarationOrStatement]
	OBtail [empty] 
    by
	ORbody 
end function

function addNewImports ORimports [list optVarOrForwardId] 
    replace [importList]
        'import ( Oimports [list optVarOrForwardId] ) 
    by
        'import ( Oimports [, ORimports] )
end function

function addNewExports ORexports [list optOpaqueId] 
    replace [exportList]
        'export ( Oexports [list optOpaqueId] )
    by
        'export ( Oexports [, ORexports] )
end function


% Rules to allow dynamic collections of objects

rule transformCollectionObjects ObName [id]
    replace [repeat declarationOrStatement]
        var ObVar [id] : collection of ObName
        RestOfScope [repeat declarationOrStatement]
    construct NewObVar [id]
    	ObVar [!]
    by
        var ObVar : collection of ObName . DataRecordType
        RestOfScope 
            [changeCollectionAllocations ObVar NewObVar ObName]
            [changeCollectionProcs ObVar NewObVar ObName]
end rule

rule changeCollectionAllocations ObVar [id] NewObVar [id] ObName [id]
    replace [repeat declarationOrStatement]
        new ObVar , Ptr [reference]
        RestOfScope [repeat declarationOrStatement]
    by
        new NewObVar , Ptr 
        ObName . InitializeDataRecord ( NewObVar ( Ptr ) )
        RestOfScope
end rule

rule changeCollectionProcs ObVar [id] NewObVar [id] ObName [id]
    replace [procedureCall]
        ObVar Sub [subscript] . PName [id] ( Acts [expn] RestActs [repeat commaExpn] )
    by
        ObName . PName (NewObVar Sub, Acts RestActs)
end rule
